www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\admin\adminKernel\D_asp_code_str_for_complie_conn.asp
<%
'**************************************************************
' 新动软网站管理系统
' 官方网站: http://www.aspcpu.com
' 系统作者: 阮丁远(网名：天 下 程 序)
' Copyright 新动软网站管理系统 版权所有
'**************************************************************
%>
<%
'全局考虑，加on error resume next
on error resume next
dir_set="..\"
nodooooooa=0
if have_a1="" then
have_a1="1"
'***********************************************
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function
'Dim Fy_Url,Fy_a,Fy_x,Fy_Cs(),Fy_Cl,Fy_Ts,Fy_Zx
'---定义部份 头------
Fy_Cl = 2 '处理方式：1=提示信息,2=转向页面,3=先提示再转向
Fy_Zx = "/Error.Asp" '出错时转向的页面
'---定义部份 尾------
'ruandingyuan xiugai
Fy_Url=Request.ServerVariables("QUERY_STRING")
Fy_a=split(Fy_Url,"&")
redim Fy_Cs(ubound(Fy_a))
for Fy_x=0 to ubound(Fy_a)
Fy_Cs(Fy_x) = left(Fy_a(Fy_x),instr(Fy_a(Fy_x),"=")-1)
Next
For Fy_x=0 to ubound(Fy_Cs)
If Fy_Cs(Fy_x)<>"" Then
If Instr(LCase(Request(Fy_Cs(Fy_x))),"'")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and ")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and%20")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"select")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"update")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"set")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"chr")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"delete%20from")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"delete")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"from")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),";")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"insert")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"into")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"mid")<>0 Or Instr(LCase(Request(Fy_Cs(Fy_x))),"master.")<>0 Then
Select Case Fy_Cl
Case "1"
Response.Write "<Script Language=JavaScript>alert('出现错误！参数 "&Fy_Cs(Fy_x)&" 的值中包含非法字符串！\n\n 请不要在参数中出现：;,and%20,select%20,update%20,insert%20,delete,chr 等非法字符！);window.close();</Script>"
Case "2"
Response.Write "<Script Language=JavaScript>location.href='"&Fy_Zx&"'</Script>"
Case "3"
Response.Write "<Script Language=JavaScript>alert('出现错误！参数 "&Fy_Cs(Fy_x)&"的值中包含非法字符串！\n\n 请不要在参数中出现：;,and%20,select%20,update%20,insert%20,delete%20,chr 等非法字符！);location.href='"&Fy_Zx&"';</Script>"
End Select
nodooooooa=1
Response.End
End If
End If
Next
'post方式的sql注入，则直接禁止站点外部提交post
if lcase(Request.Servervariables("REQUEST_METHOD"))="post" then
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(server_v1,8,len(server_v2))<>server_v2 then
nodooooooa=1
response.write "<br><br><center><table border=1 cellpadding=20 bordercolor=black bgcolor=#EEEEEE width=450>"
response.write "<tr><td style='font:9pt Verdana'>"
response.write "你提交的路径有误,禁止从站点外部提交数据,请不要乱该参数！"
response.write "</td></tr></table></center>"
response.end
end if
end if
nd_web_output_folder_b="xndasp"
nd_web_output_folder_qiye_b="xcomasp"
'Dim ConnStr
if nodooooooa=0 then
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(dir_set&"$$xxxx_d_soft_complie$$db_str$")
Set $$xxxx_d_soft_complie$$conn$ = Server.CreateObject("ADODB.Connection")
$$xxxx_d_soft_complie$$conn$.open ConnStr
If Err Then
Err.Clear
Set $$xxxx_d_soft_complie$$conn$ = Nothing
Response.Write "数据库连接出错，请检查Conn.asp文件中的数据库参数设置。"
Response.End
End If
end if
if request("ruandingyuan_do")="getinfox" then
response.write "本站使用新"&""&"动"&"软系统制作,"&"系"&"统"&"作"&"者:"&"阮"&""&"丁"&"远,官网:ww"&"w.as"&"pcpu.com"
response.end
end if
J_True = "True"
J_False = "False"
J_Now = "Now()" '获得现在的时间
end if
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
if is_haved_g_fontaa="" then
is_haved_g_fontaa="1"
Function getFontMode(str, vColor, vFont,vSize)
Dim FontStr, tColor
Dim ColorStr, arrColor
If IsNull(str) Then
getFontMode = ""
Exit Function
End If
getFontMode = str
FontStr=str
Select Case CInt(vFont)
Case 1
FontStr = "<b>" & str & "</b>"
Case 2
FontStr = "<em>" & str & "</em>"
Case 3
FontStr = "<u>" & str & "</u>"
Case 4
FontStr = "<b><em>" & str & "</em></b>"
Case 5
FontStr = "<b><u>" & str & "</u></b>"
Case 6
FontStr = "<em><u>" & str & "</u></em>"
Case 7
FontStr = "<b><em><u>" & str & "</u></em></b>"
Case Else
FontStr = str
End Select
getFontMode = FontStr
If vColor = "" Then Exit Function
'ColorStr = "," & InitTitleColor
'arrColor = Split(ColorStr, ",")
'If vColor > UBound(arrColor) Then Exit Function
'tColor = Trim(arrColor(vColor))
if vColor ="0" then
'ssscolor="<font style='font-size:"&vSize&" px;'>"
'ssscolor2="</font>"
else
'ssscolor="<font color="&vColor&" style='font-size:"&vSize&" px;'>"
'ssscolor2="</font>"
ssscolor="<span style='color:"&vColor&";'>"
ssscolor2="</span>"
end if
getFontMode = ssscolor& FontStr & ssscolor2
End Function
end if
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
if haved_atype_a="" then
haved_atype_a="1"
function get_art_type(in1)
get_art_type=""
if in1="1" then get_art_type="<font color=red>[图文]</font>"
if in1="2" then get_art_type="<font color=red>[组图]</font>"
if in1="3" then get_art_type="<font color=red>[新闻]</font>"
if in1="4" then get_art_type="<font color=red>[推荐]</font>"
if in1="5" then get_art_type="<font color=red>[注意]</font>"
if in1="6" then get_art_type="<font color=red>[转载]</font>"
if in1="7" then get_art_type="<font color=red>[最新]</font>"
end function
end if
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
function findx_price(grade_id,str)
rst2=""
if str<>"" then
other_params=split(str,"|")
for i=0 to ubound(other_params)
sss11=split(other_params(i),":")
sss11a=sss11(0)
sss11b=sss11(1)
if cstr(sss11a)=cstr(grade_id) then
rst2=sss11b
exit for
end if
next
end if
if isnumeric(rst2)<>true then
rst2=""
end if
findx_price=rst2
end function
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
Function n_RemoveHTML_mdx(strHTML)
n_RemoveHTML_md=""
on error resume next
strHTML=cstr(strHTML&"")
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
' 遍历匹配集合，并替换掉匹配的项目
For Each Match in Matches
strHtml=Replace(strHTML,Match.Value,"")
Next
n_RemoveHTML_mdx=strHTML
Set objRegExp = Nothing
End Function
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
function replace_huanhangz(cont)
cont=replace(cont,vbcrlf,"$$sx_aspcodex_huanhang$")
cont=replace(cont,chr(10),"$$sx_aspcodex_huanhang$")
cont= Replace(cont, CHR(13), "$$sx_aspcodex_huanhang$")
cont= Replace(cont, CHR(9), "$$sx_aspcodex_huanhang$")
cont=replace(cont,"=","$zzdenghaoaspcpu1$")
cont=replace(cont,"&","$zzadnnhaoaspcpu1$")
cont=replace(cont,"?","$zzwnnehaoaspcpu1$")
replace_huanhangz=cont
end function
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
Function UrlEncoding_x(DataStr)
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr, Si, 1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00) \ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding_x = StrReturn
End Function
%>